Libris Britannia 4/science library(b).zip/science library(b)/PROGRAMM/DB_CLIPP/1159.ZIP/ISR.PRG

Text File | 1987-03-17 | 15KB | 731 lines

*              This program is a work of the Tennessee Valley
*              Authority (TVA), U.S. Government, and is in
*              the public domain.
*
* TVA MAKES NO REPRESENTATION OR WARRENTY OF ANY KIND WHATSOEVER, INCLUDING,
* BUT NOT LIMITED TO, REPRESENTATIONS OR WARRENTIES, EXPRESSED OR IMPLIED, OF
* MERCHANTABILITY, FITNESS FOR SPECIFIC USE OR PURPOSE, accuracy or
* completeness of processes, procedures, designs, definitions, instructions,
* information, or functioning of the program(s) and related material; TVA
* further expressly disclaims any knowledge or purpose for which the program(s)
* may be utilized or its applicability for such use, nor shall the fact of
* making it available constitute any such representation, warranty, or
* knowledge, nor does TVA assume any liability, responsibility, or obligation
* arising from the use or malfunctioning of the computer program(s) or related
* materials.
*
CLEAR
SET HELP OFF
SET TALK OFF
SET ESCAPE OFF
SET SAFETY OFF
SET BELL OFF
SET SCOREBOARD OFF
CLOSE DATABASES
USE REPWORK
ZAP
USE REPERR
ZAP
USE REPDUP
INDEX ON TVA_NO TO REPDNX
SET INDEX TO REPDNX
ZAP
USE REPDEL
ZAP
USE
PUBLIC DBNAME,INDEX1,INDEX2,DTCHECK,OSS,INSTNAME,TVANUMBER,SERIALNUM,CALIBDATE
PUBLIC DUEDATE,CALINTERVL,LOCATNAME,REMARKNM,CATEGORY1,CATEGORY2,CATEGORY3
PUBLIC SUBCAT1,SUBCAT2,SUBCAT3,SUB1ABB,SUB2ABB,SUB3ABB,CAT3ABB,TITLE1,CALOVER
PUBLIC SPACING,PAPEROUT,CMDATE,DUPREC,TVAID,SERID,MULTTV,MULTSN,NP,GLPRINT
DATABASE21='O'
RESTORE FROM DATANAME ADDITIVE
IF FILE ("PUB_DOM.AIN")
?'             This program is a work of the Tennessee Valley'
?'             Authority (TVA), U.S. Government, and is in'
?'             the public domain.'
?
?'TVA MAKES NO REPRESENTATION OR WARRENTY OF ANY KIND WHATSOEVER, INCLUDING,'
?'BUT NOT LIMITED TO, REPRESENTATIONS OR WARRENTIES, EXPRESSED OR IMPLIED, OF'
?'MERCHANTABILITY, FITNESS FOR SPECIFIC USE OR PURPOSE, accuracy or'
?'completeness of processes, procedures, designs, definitions, instructions,'
?'information, or functioning of the program(s) and related material; TVA'
?'further expressly disclaims any knowledge or purpose for which the program(s)'
?'may be utilized or its applicability for such use, nor shall the fact of'
?'making it available constitute any such representation, warranty, or'
?'knowledge, nor does TVA assume any liability, responsibility, or obligation'
?'arising from the use or malfunctioning of the computer program(s) or'
?'related materials.'
?
?
?
?
?
WAIT '                 Press any key to continue.' TO AAAAAA
ENDIF
IF DATABASE21='1'
  SET COLOR TO W/B,W/R,BG
ENDIF
DREMARK='DATE OVERRIDE IS ON.'
TDREMARK='TEMPORARY DATE OVERRIDE.'
ADDFILE=0
MODFILE=0
GLCALDU=0
MULTTV=0
MULTSN=0
CALOVER=0
N4='K'
DO WHILE N4#'Y' .AND. N4#'N'
 CLEAR
 @ 0,37 SAY 'ISR-20'
 @ 2,33 SAY '(Version 3.03)'
 @ 4,30 SAY 'by Marty L. Jamieson'
 @ 7,34 SAY 'IS THE YEAR'
 @ 9,36 SAY YEAR(DATE())
 @ 11,38 SAY 'AND'
 @ 13,31 SAY 'THE MONTH AND DAY'
 @ 15,40-INT((LEN(CMONTH(DATE()))+3)/2+.5) SAY CMONTH(DATE())
 ??' '
 ?? DAY(DATE())
 @ 17,38 SAY 'AND'
 @ 19,31 SAY 'THE NAME OF TODAY'
 @ 21,40-INT(LEN(CDOW(DATE()))/2+.5) SAY CDOW(DATE())
 @ 24,12 SAY 'CORRECT DATE IS CRITICAL FOR PROPER FUNCTIONING OF ISR-20'
 @ 22,0 SAY ' '
 WAIT '                                     (Y/N)' TO N4
 N4=UPPER(N4)
IF N4='N'
 CLEAR
 @ 0,7 SAY "Please enter today's date."
 ?
 RUN DATE
 N4='K'
ENDIF
ENDDO
DO WHILE N4#'STOP'
DO WHILE ASC(N4)<65 .OR. ASC(N4)>86
CLEAR
@ 0,19 SAY 'What would you like to do ?'
@ 2,19 SAY 'A)  Go to the '
?? DATABASE1
??' data base.'
@ 3,19 SAY 'B)  Go to the '
?? DATABASE2
??' data base.'
@ 4,19 SAY 'C)  Go to the '
?? DATABASE3
??' data base.'
@ 5,19 SAY 'D)  Go to the '
?? DATABASE4
??' data base.'
@ 6,19 SAY 'E)  Go to the '
?? DATABASE5
??' data base.'
@ 7,19 SAY 'F)  Go to the '
?? DATABASE6
??' data base.'
@ 8,19 SAY 'G)  Go to the '
?? DATABASE7
??' data base.'
@ 9,19 SAY 'H)  Go to the '
?? DATABASE8
??' data base.'
@ 10,19 SAY 'I)  Go to the '
?? DATABASE9
??' data base.'
@ 11,19 SAY 'J)  Go to the '
?? DATABASE10
??' data base.'
@ 12,19 SAY 'K)  Go to the '
?? DATABASE11
??' data base.'
@ 13,19 SAY 'L)  Go to the '
?? DATABASE12
??' data base.'
@ 14,19 SAY 'M)  Go to the '
?? DATABASE13
??' data base.'
@ 15,19 SAY 'N)  Go to the '
?? DATABASE14
??' data base.'
@ 16,19 SAY 'O)  Go to the '
?? DATABASE15
??' data base.'
@ 17,19 SAY 'P)  Go to the '
?? DATABASE16
??' data base.'
@ 18,19 SAY 'Q)  Go to the '
?? DATABASE17
??' data base.'
@ 19,19 SAY 'R)  Go to the '
?? DATABASE18
??' data base.'
@ 20,19 SAY 'S)  Go to the '
?? DATABASE19
??' data base.'
@ 21,19 SAY 'T)  Go to the '
?? DATABASE20
??' data base.'
@ 22,19 SAY 'U)  Other options.'
WAIT '                   V)  QUIT   ' TO N4
??'    WORKING . . .'
N4=UPPER(N4)
ENDDO
GLPRINT=0
N6='Z'
DO CASE
 CASE N4='V'
  CLEAR ALL
  RUN CD\
  SET COLOR TO
  QUIT
 CASE N4='A'
  NCHR='1'
  DO DBSELECT
  DO OSSCOM
 CASE N4='B'
  NCHR='2'
  DO DBSELECT
  DO OSSCOM
 CASE N4='C'
  NCHR='3'
  DO DBSELECT
  DO OSSCOM
 CASE N4='D'
  NCHR='4'
  DO DBSELECT
  DO OSSCOM
 CASE N4='E'
  NCHR='5'
  DO DBSELECT
  DO OSSCOM
 CASE N4='F'
  NCHR='6'
  DO DBSELECT
  DO OSSCOM
 CASE N4='G'
  NCHR='7'
  DO DBSELECT
  DO OSSCOM
 CASE N4='H'
  NCHR='8'
  DO DBSELECT
  DO OSSCOM
 CASE N4='I'
  NCHR='9'
  DO DBSELECT
  DO OSSCOM
 CASE N4='J'
  NCHR='10'
  DO DBSELECT
  DO OSSCOM
 CASE N4='K'
  NCHR='11'
  DO DBSELECT
  DO OSSCOM
 CASE N4='L'
  NCHR='12'
  DO DBSELECT
  DO OSSCOM
 CASE N4='M'
  NCHR='13'
  DO DBSELECT
  DO OSSCOM
 CASE N4='N'
  NCHR='14'
  DO DBSELECT
  DO OSSCOM
 CASE N4='O'
  NCHR='15'
  DO DBSELECT
  DO OSSCOM
 CASE N4='P'
  NCHR='16'
  DO DBSELECT
  DO OSSCOM
 CASE N4='Q'
  NCHR='17'
  DO DBSELECT
  DO OSSCOM
 CASE N4='R'
  NCHR='18'
  DO DBSELECT
  DO OSSCOM
 CASE N4='S'
  NCHR='19'
  DO DBSELECT
  DO OSSCOM
 CASE N4='T'
  NCHR='20'
  DO DBSELECT
  DO OSSCOM
 CASE N4='U'
  N4='Z'
  N6=N4
 DO WHILE ASC(N6)<65.OR.ASC(N6)>68
  CLEAR
  @ 1,14 SAY 'What do you want to do ?'
  @ 4,10 SAY 'A)  Set data base options and conditions.'
  @ 6,10 SAY 'B)  Rebuild data base(s) to the most efficient structure.'
  @ 8,10 SAY 'C)  Rebuild data base(s) which you believe may possibly be ;
damaged.'
  @ 9,14 SAY '(The index files associated with the data base(s) will be rebuilt'
  @ 10,14 SAY 'from scratch.)'
  @ 12,10 SAY 'D)  Do a Global Search on the "NEXT DATE" field (fifth column) '
  ?? 'in '
  @ 13,14 SAY 'ALL data bases from date to date, and print out the qualifying'
  @ 14,14 SAY 'records.  (The search will include all categories and'
  @ 15,14 SAY 'subcategories.  Where the date has been overridden, the'
  @ 16,14 SAY 'date listed in the "NEXT DATE" field will be considered to'
  @ 17,14 SAY 'be correct.)'
  @ 19,10 SAY 'E)  Change from monochromatic to color or vice-versa.'
  @ 22,14 SAY 'Press RETURN to return to the previous menu.'
  WAIT '                            ' TO N6
  ??'  WORKING . . .'
  N6=UPPER(N6)
  DO CASE
   CASE ASC(N6)=0
    EXIT
   CASE N6='A'
    DO OPTSET.PRG
   CASE N6='D'
MULTTV=0
MULTSN=0
  COMPDATE1=CTOD('12/12/86')
  COMPDATE2=CTOD('12/12/84')
 DO WHILE COMPDATE1>COMPDATE2
  N6=N4
  DO WHILE N6#'Y'
  @ 14,0 CLEAR
  ?'What beginning date do you choose ?'
  ?
  ACCEPT 'Date format:  ##/##/####      DATE:  ' TO CHOSDATE
  CHOSDATE=LTRIM(TRIM(CHOSDATE))
  IF ASC(CHOSDATE)=0
   EXIT
  ENDIF
  COMPDATE1=CTOD(CHOSDATE)
 IF LEN(CHOSDATE)<9
  IF YEAR(COMPDATE1)+100-YEAR(DATE())<10
   MOCALDT=MONTH(COMPDATE1)
   DYCALDT=DAY(COMPDATE1)
   YRCALDT=INT(YEAR(COMPDATE1)+100+.5)
   IF MOCALDT<10
     M=1
    ELSE
     M=2
   ENDIF
   IF DYCALDT<10
     D=1
    ELSE
     D=2
   ENDIF
   COMPDATE1=CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+STR(YRCALDT,4,0))
  ENDIF
 ENDIF
  ??'Is '
  ?? CDOW(COMPDATE1)
  ??', '
  ?? CMONTH(COMPDATE1)
  ?? DAY(COMPDATE1)
  ??', '
  ?? YEAR(COMPDATE1)
  ??' the date which you want ?  (Y/N)'
  WAIT '                                                           ' TO N6
  N6=UPPER(N6)
  IF ASC(N6)=0
   EXIT
  ENDIF
  ENDDO
  ?
  ?
  N6=N4
  DO WHILE N6#'Y'
  @ 14,0 CLEAR
  ?'What ending date do you choose ?'
  ?
  ACCEPT 'Date format:  ##/##/####      DATE:  ' TO CHOSDATE
  CHOSDATE=LTRIM(TRIM(CHOSDATE))
  IF ASC(CHOSDATE)=0
   EXIT
  ENDIF
  COMPDATE2=CTOD(CHOSDATE)
 IF LEN(CHOSDATE)<9
  IF YEAR(COMPDATE2)+100-YEAR(DATE())<10
   MOCALDT=MONTH(COMPDATE2)
   DYCALDT=DAY(COMPDATE2)
   YRCALDT=INT(YEAR(COMPDATE2)+100+.5)
   IF MOCALDT<10
     M=1
    ELSE
     M=2
   ENDIF
   IF DYCALDT<10
     D=1
    ELSE
     D=2
   ENDIF
   COMPDATE2=CTOD(STR(MOCALDT,M,0)+'/'+STR(DYCALDT,D,0)+'/'+STR(YRCALDT,4,0))
  ENDIF
 ENDIF
  ??'Is '
  ?? CDOW(COMPDATE2)
  ??', '
  ?? CMONTH(COMPDATE2)
  ?? DAY(COMPDATE2)
  ??', '
  ?? YEAR(COMPDATE2)
  ??' the date which you want ?  (Y/N)'
  WAIT '                                                           ' TO N6
  N6=UPPER(N6)
  IF ASC(N6)=0
   EXIT
  ENDIF
  ENDDO
  ?
  ?
  IF COMPDATE1>COMPDATE2
   @ 14,0 CLEAR
   ?'                         INVALID DATE ENTRY'
   ?
   ?
   WAIT '                    Press any key to continue . . .' TO N1
  ENDIF
 ENDDO
    GLCALDU=1
    PRINTOUT=1
    ADDFILE=0
    MODFILE=0
    VIEW=0
 READY='K'
 DO WHILE READY#'Y'
  CLEAR
  GOBACK=0
  ?
  ?'Depending upon the date selections you have made, very small to very large'
  ?
  ?'amounts of data may be printed, up to the capacity of your computer'
  ?
  ?'system.  You may escape this routine by pressing the "RETURN" key at this'
  ?
 ?'time.  Make SURE the printer is ready to print.  Then press "Y" to continue,'
  ?
  ?'or else press "RETURN" to return to the MAIN menu.'
  ?
  ?
  ?'PLEASE NOTE:  If you should ever make a mistake and there is a system error'
  ?
  ?'because the printer is not ready, FIRST enable the printer and THEN press'
  ?
  ?'"I" for the "ignor" option until no further error is indicated.'
  ?
  WAIT '                                    ' TO READY
  READY=UPPER(READY)
  IF ASC(READY)=0
   GOBACK=1
   EXIT
  ENDIF
 ENDDO
    IF GOBACK=1
     EXIT
    ENDIF
    CNN=1
    PRNTED=0
    GLPRINT=1
    CLEAR
    DO WHILE CNN<21
     NCHR=LTRIM(STR(CNN))
     DO DBSELECT
     SELECT 1
     @ 8,15 SAY 'PLEASE DO NOT PRESS ANY KEYS DURING THIS PROCEDURE.'
     @ 14,20 SAY 'Data base in use:'
     @ 14,38 CLEAR
     @ 14,38 SAY OSS
     SET FILTER TO COMPDATE1<=CAL_DUE_DT.AND.COMPDATE2>=CAL_DUE_DT
     GO TOP
     IF .NOT. EOF()
      PRNTED=1
      DO REPINSTP
     ENDIF
     CNN=CNN+1
    ENDDO
    IF PRNTED=1
     EJECT
     EJECT
    ENDIF
    GLCALDU=0
    N7='Z'
   CASE N6='B'.OR.N6='C'
   N7='Z'
  DO WHILE ASC(N7)<65.OR.ASC(N7)>84
CLEAR
IF N6='C'
@ 0,19 SAY '(For possibly damaged files.)'
ENDIF
@ 1,19 SAY 'What would you like to do ?'
@ 3,19 SAY 'A)  Rebuild the '
?? DATABASE1
??' data base.'
@ 4,19 SAY 'B)  Rebuild the '
?? DATABASE2
??' data base.'
@ 5,19 SAY 'C)  Rebuild the '
?? DATABASE3
??' data base.'
@ 6,19 SAY 'D)  Rebuild the '
?? DATABASE4
??' data base.'
@ 7,19 SAY 'E)  Rebuild the '
?? DATABASE5
??' data base.'
@ 8,19 SAY 'F)  Rebuild the '
?? DATABASE6
??' data base.'
@ 9,19 SAY 'G)  Rebuild the '
?? DATABASE7
??' data base.'
@ 10,19 SAY 'H)  Rebuild the '
?? DATABASE8
??' data base.'
@ 11,19 SAY 'I)  Rebuild the '
?? DATABASE9
??' data base.'
@ 12,19 SAY 'J)  Rebuild the '
?? DATABASE10
??' data base.'
@ 13,19 SAY 'K)  Rebuild the '
?? DATABASE11
??' data base.'
@ 14,19 SAY 'L)  Rebuild the '
?? DATABASE12
??' data base.'
@ 15,19 SAY 'M)  Rebuild the '
?? DATABASE13
??' data base.'
@ 16,19 SAY 'N)  Rebuild the '
?? DATABASE14
??' data base.'
@ 17,19 SAY 'O)  Rebuild the '
?? DATABASE15
??' data base.'
@ 18,19 SAY 'P)  Rebuild the '
?? DATABASE16
??' data base.'
@ 19,19 SAY 'Q)  Rebuild the '
?? DATABASE17
??' data base.'
@ 20,19 SAY 'R)  Rebuild the '
?? DATABASE18
??' data base.'
@ 21,19 SAY 'S)  Rebuild the '
?? DATABASE19
??' data base.'
@ 22,19 SAY 'T)  Rebuild the '
?? DATABASE20
??' data base.'
WAIT '    Press "RETURN" to escape this routine and go to the previous;
 menu.' TO N7
??' WORKING'
N7=UPPER(N7)
IF ASC(N7)=0
 EXIT
ENDIF
DO CASE
 CASE N7='A'
  NCHR='1'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='B'
  NCHR='2'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='C'
  NCHR='3'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='D'
  NCHR='4'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='E'
  NCHR='5'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='F'
  NCHR='6'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='G'
  NCHR='7'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='H'
  NCHR='8'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='I'
  NCHR='9'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='J'
  NCHR='10'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='K'
  NCHR='11'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='L'
  NCHR='12'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='M'
  NCHR='13'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='N'
  NCHR='14'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='O'
  NCHR='15'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='P'
  NCHR='16'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='Q'
  NCHR='17'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='R'
  NCHR='18'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='S'
  NCHR='19'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 CASE N7='T'
  NCHR='20'
  IF N6='A'
   DBINDEX=0
   DO DBPACK
  ELSE
   DBINDEX=1
   DO DBPACK
  ENDIF
 ENDCASE
 N7='Z'
 ENDDO
 CASE N6='E'
  IF DATABASE21='1'
   SET COLOR TO
   DATABASE21='O'
   ELSE
    DATABASE21='1'
    SET COLOR TO W/B,W/R,BG
  ENDIF
  SAVE ALL LIKE DATABASE* TO DATANAME
ENDCASE
 N6='Z'
ENDDO
ENDCASE
ENDDO
RETURN